home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 076-100 / disk_077 / samples / wator.d < prev   
Text File  |  1992-05-06  |  11KB  |  535 lines
  1. #include:util.g
  2. #include:crt.g
  3.  
  4. /*
  5.  * WATOR - simulation of the torus world of Wa-Tor, with a population of
  6.  *       sharks and fish. Size of display = 23 lines x 80 columns.
  7.  *
  8.  * Idea from: "Computer Recreations" by A. K. Dewdney in December 1984
  9.  *        Scientific American.
  10.  *
  11.  * Programmed: December 10, 1984, by Chris Gray.
  12.  * Language: Draco
  13.  */
  14.  
  15. ushort
  16.     NLINES = 23,        /* number of lines displayed and run */
  17.     NCOLUMNS = 80;        /* number of columns displayed and run */
  18.  
  19. /* footer line with statistics:
  20.  
  21. NSharks: xxxx  NFish: xxxx  Time: xxxxx  SBreed: xx  FBreed: xx  Starve: xx
  22.  
  23. */
  24.  
  25. ushort
  26.     NSHARKSCOLUMN = 9,
  27.     NFISHCOLUMN = 22,
  28.     TIMECOLUMN = 34,
  29.     SBREEDCOLUMN = 49,
  30.     FBREEDCOLUMN = 61,
  31.     STARVECOLUMN = 73;
  32.  
  33. byte
  34.     SHARK = 0x01,        /* shark is present in this ocean cell */
  35.     FISH = 0x02,        /* fish is present in this ocean cell */
  36.     NEWSHARK = 0x04,        /* shark has moved here this cronon */
  37.     NEWFISH = 0x08;        /* fish has moved here this cronon */
  38.  
  39. type
  40.     CELL = struct {
  41.     byte f_flags;
  42.     ushort f_age;
  43.     ushort s_age;
  44.     ushort s_eat;
  45.     };
  46.  
  47. uint
  48.     NSharks,            /* number of sharks currently alive */
  49.     NFish,            /* number of fish currently alive */
  50.     Time;            /* the current time */
  51.  
  52. ushort
  53.     SBreed,            /* breeding time for sharks */
  54.     FBreed,            /* breeding time for fish */
  55.     Starve;            /* starvation time for sharks */
  56.  
  57. [NLINES, NCOLUMNS] CELL Ocean;    /* the ocean of Wa-Tor */
  58.  
  59. channel output text
  60.     CRTOut,            /* formatted output to screen */
  61.     LogOut;            /* statistics logging */
  62.  
  63. bool Logging;            /* true if logging is enabled */
  64.  
  65. file() File;            /* file for save, restore and logging */
  66.  
  67. /*
  68.  * initialize - set up the screen and the various data structures.
  69.  */
  70.  
  71. proc initialize()void:
  72.     *CELL p;
  73.     uint i;
  74.     ushort l, c;
  75.  
  76.     p := &Ocean[0, 0];
  77.     for i from 0 upto NLINES * NCOLUMNS - 1 do
  78.     p*.f_flags := 0x00;
  79.     p := p + sizeof(CELL);
  80.     od;
  81.     Time := 0;
  82. corp;
  83.  
  84. /*
  85.  * beep - beep to indicate an error (send BEL to terminal).
  86.  */
  87.  
  88. proc beep()void:
  89.  
  90.     CRT_PutChar('\(0x07)');
  91. corp;
  92.  
  93. /*
  94.  * findCell - find a random cell meeting the given mask requirements.
  95.  *          Return 'false' if no neighbouring cell is satisfactory.
  96.  */
  97.  
  98. proc findCell(byte mask, value; **CELL pp; ushort l, c)bool:
  99.     *CELL p, p1;
  100.     ushort count;
  101.     [4] *CELL neighbour;
  102.  
  103.     p1 := pp*;
  104.     count := 0;
  105.     p :=
  106.     if l = NLINES - 1 then
  107.         p1 - ((NLINES - 1) * NCOLUMNS * sizeof(CELL))
  108.     else
  109.         p1 + (NCOLUMNS * sizeof(CELL))
  110.     fi;
  111.     if p*.f_flags & mask = value then
  112.     neighbour[count] := p;
  113.     count := count + 1;
  114.     fi;
  115.     p :=
  116.     if l = 0 then
  117.         p1 + ((NLINES - 1) * NCOLUMNS * sizeof(CELL))
  118.     else
  119.         p1 - (NCOLUMNS * sizeof(CELL))
  120.     fi;
  121.     if p*.f_flags & mask = value then
  122.     neighbour[count] := p;
  123.     count := count + 1;
  124.     fi;
  125.     p :=
  126.     if c = NCOLUMNS - 1 then
  127.         p1 - ((NCOLUMNS - 1) * sizeof(CELL))
  128.     else
  129.         p1 + sizeof(CELL)
  130.     fi;
  131.     if p*.f_flags & mask = value then
  132.     neighbour[count] := p;
  133.     count := count + 1;
  134.     fi;
  135.     p :=
  136.     if c = 0 then
  137.         p1 + ((NCOLUMNS - 1) * sizeof(CELL))
  138.     else
  139.         p1 - sizeof(CELL)
  140.     fi;
  141.     if p*.f_flags & mask = value then
  142.     neighbour[count] := p;
  143.     count := count + 1;
  144.     fi;
  145.     if count = 0 then
  146.     false
  147.     else
  148.     count := CRT_Random(count);
  149.     pp* := neighbour[count];
  150.     true
  151.     fi
  152. corp;
  153.  
  154. /*
  155.  * updateFish - update and regenerate the fish.
  156.  */
  157.  
  158. proc updateFish()void:
  159.     *CELL p, p1;
  160.     ushort l, c;
  161.  
  162.     p := &Ocean[0, 0];
  163.     for l from 0 upto NLINES - 1 do
  164.     for c from 0 upto NCOLUMNS - 1 do
  165.         if p*.f_flags & FISH ~= 0x00 then
  166.         p1 := p;
  167.         if findCell(NEWFISH | FISH, 0x00, &p1, l, c) then
  168.             p1*.f_flags := p1*.f_flags | NEWFISH;
  169.             p1*.f_age := p*.f_age + 1;
  170.             if p1*.f_age = FBreed then
  171.             /*
  172.              * it's giving birth to a new fish at old position.
  173.              */
  174.             p1*.f_age := 0;
  175.             p*.f_flags := p*.f_flags | NEWFISH;
  176.             p*.f_age := CRT_Random((FBreed + 1) / 2);
  177.             NFish := NFish + 1;
  178.             fi;
  179.         else
  180.             p*.f_flags := p*.f_flags | NEWFISH;
  181.         fi;
  182.         fi;
  183.         p := p + sizeof(CELL);
  184.     od;
  185.     od;
  186. corp;
  187.  
  188. /*
  189.  * updateSharks - update and regenerate the sharks and eat the fish.
  190.  */
  191.  
  192. proc updateSharks()void:
  193.     *CELL p, p1;
  194.     ushort l, c;
  195.     bool moved;
  196.  
  197.     p := &Ocean[0, 0];
  198.     for l from 0 upto NLINES - 1 do
  199.     for c from 0 upto NCOLUMNS - 1 do
  200.         if p*.f_flags & SHARK ~= 0x00 then
  201.         moved := false;
  202.         p1 := p;
  203.         if findCell(NEWFISH|NEWSHARK|SHARK, NEWFISH, &p1, l, c) then
  204.             /*
  205.              * this shark is eating a fish.
  206.              */
  207.             p1*.f_flags := p1*.f_flags | NEWSHARK;
  208.             p1*.s_eat := 0;
  209.             NFish := NFish - 1;
  210.             moved := true;
  211.         else
  212.             p*.s_eat := p*.s_eat + 1;
  213.             if p*.s_eat = Starve then
  214.             /*
  215.              * this shark has starved to death
  216.              */
  217.             NSharks := NSharks - 1;
  218.             else
  219.             if findCell(FISH|NEWSHARK|SHARK,FISH, &p1, l, c) or
  220.                 findCell(NEWSHARK|SHARK,0x00, &p1, l, c) then
  221.                 /*
  222.                  * shark will chase a fish if one WAS nearby,
  223.                  * otherwise it just wanders.
  224.                  */
  225.                 p1*.f_flags := p1*.f_flags | NEWSHARK;
  226.                 p1*.s_eat := p*.s_eat;
  227.                 moved := true;
  228.             else
  229.                 p*.f_flags := p*.f_flags | NEWSHARK;
  230.                 if p*.f_flags & NEWFISH ~= 0x00 then
  231.                 /*
  232.                  * poor fish swam right to him!
  233.                  */
  234.                 p*.s_eat := 0;
  235.                 NFish := NFish - 1;
  236.                 fi;
  237.             fi;
  238.             fi;
  239.         fi;
  240.         if moved then
  241.             p1*.s_age := p*.s_age + 1;
  242.             if p1*.s_age = SBreed then
  243.             /*
  244.              * it's giving birth to a new shark at old position.
  245.              */
  246.             p1*.s_age := 0;
  247.             if p*.f_flags & NEWFISH ~= 0x00 then
  248.                 /*
  249.                  * unlucky fish there is eaten by newborn!
  250.                  */
  251.                 NFish := NFish - 1;
  252.             fi;
  253.             p*.f_flags := p*.f_flags | NEWSHARK;
  254.             p*.s_age := CRT_Random((SBreed + 1) / 2);
  255.             p*.s_eat := 0;
  256.             NSharks := NSharks + 1;
  257.             fi;
  258.         fi;
  259.         fi;
  260.         p := p + sizeof(CELL);
  261.     od;
  262.     od;
  263. corp;
  264.  
  265. /*
  266.  * updateDisplay - redraw the changes to the screen and reset Ocean.
  267.  */
  268.  
  269. proc updateDisplay()void:
  270.     *CELL p;
  271.     ushort l, c;
  272.     byte b;
  273.  
  274.     p := &Ocean[0, 0];
  275.     for l from 0 upto NLINES - 1 do
  276.     for c from 0 upto NCOLUMNS - 1 do
  277.         b := p*.f_flags;
  278.         if b & NEWSHARK ~= 0x00 then
  279.         if b & SHARK = 0x00 then
  280.             CRT_Move(l, c);
  281.             CRT_PutChar('0');
  282.         fi;
  283.         p*.f_flags := SHARK;
  284.         elif b & NEWFISH ~= 0x00 then
  285.         if b & FISH = 0x00 then
  286.             CRT_Move(l, c);
  287.             CRT_PutChar('.');
  288.         fi;
  289.         p*.f_flags := FISH;
  290.         elif b ~= 0x00 then
  291.         CRT_Move(l, c);
  292.         CRT_PutChar(' ');
  293.         p*.f_flags := 0x00;
  294.         fi;
  295.         p := p + sizeof(CELL);
  296.     od;
  297.     od;
  298.     Time := Time + 1;
  299.     CRT_Move(NLINES, NSHARKSCOLUMN);
  300.     write(CRTOut; NSharks : 4);
  301.     CRT_Move(NLINES, NFISHCOLUMN);
  302.     write(CRTOut; NFish : 4);
  303.     CRT_Move(NLINES, TIMECOLUMN);
  304.     write(CRTOut; Time : 5);
  305.     if Logging then
  306.     writeln(LogOut; NSharks, ' ', NFish);
  307.     fi;
  308. corp;
  309.  
  310. /*
  311.  * readNumber - read a number in CRT mode from the status line.
  312.  */
  313.  
  314. proc readNumber(ushort c, digits)uint:
  315.     *char p;
  316.     uint n;
  317.     [6] char buffer;
  318.  
  319.     while
  320.     CRT_Move(NLINES, c);
  321.     for n from 1 upto digits do
  322.         CRT_PutChar(' ');
  323.     od;
  324.     CRT_Move(NLINES, c);
  325.     CRT_GetLine(&buffer[0], digits + 1);
  326.     p := &buffer[0];
  327.     while p* = ' ' do
  328.         p := p + 1;
  329.     od;
  330.     if p* = '\e' then
  331.         true
  332.     else
  333.         n := 0;
  334.         while p* >= '0' and p* <= '9' do
  335.         n := n * 10 + (p* - '0');
  336.         p := p + 1;
  337.         od;
  338.         p* ~= '\e' or n = 0
  339.     fi
  340.     do
  341.     beep();     /* beep to indicate error */
  342.     od;
  343.     CRT_Move(NLINES, c);
  344.     write(CRTOut; n : digits);
  345.     n
  346. corp;
  347.  
  348. /*
  349.  * getParameters - read in the five operating parameters.
  350.  */
  351.  
  352. proc getParameters()void:
  353.  
  354.     CRT_Move(NLINES, 0);
  355.     CRT_PutChars("NSharks:");
  356.     NSharks := readNumber(NSHARKSCOLUMN, 4);
  357.     CRT_Move(NLINES, NSHARKSCOLUMN + 6);
  358.     CRT_PutChars("NFish:");
  359.     NFish := readNumber(NFISHCOLUMN, 4);
  360.     CRT_Move(NLINES, NFISHCOLUMN + 6);
  361.     CRT_PutChars("Time:     0  SBreed:");
  362.     SBreed := readNumber(SBREEDCOLUMN, 2);
  363.     CRT_Move(NLINES, SBREEDCOLUMN + 4);
  364.     CRT_PutChars("FBreed:");
  365.     FBreed := readNumber(FBREEDCOLUMN, 2);
  366.     CRT_Move(NLINES, FBREEDCOLUMN + 4);
  367.     CRT_PutChars("Starve:");
  368.     Starve := readNumber(STARVECOLUMN, 2);
  369. corp;
  370.  
  371. /*
  372.  * initializeOcean - initialize the populations and Ocean.
  373.  *             Note: if NFish and/or NSharks are too large, this
  374.  *             routine will go into an infinite loop.
  375.  */
  376.  
  377. proc initializeOcean()void:
  378.     *CELL p;
  379.     uint i;
  380.     ushort l, c;
  381.  
  382.     for i from 1 upto NFish do
  383.     while
  384.         l := CRT_Random(NLINES);
  385.         c := CRT_Random(NCOLUMNS);
  386.         p := &Ocean[l, c];
  387.         p*.f_flags ~= 0x00
  388.     do
  389.     od;
  390.     p*.f_flags := FISH;
  391.     p*.f_age := CRT_Random(FBreed);
  392.     CRT_Move(l, c);
  393.     CRT_PutChar('.');
  394.     od;
  395.     for i from 1 upto NSharks do
  396.     while
  397.         l := CRT_Random(NLINES);
  398.         c := CRT_Random(NCOLUMNS);
  399.         p := &Ocean[l, c];
  400.         p*.f_flags ~= 0x00
  401.     do
  402.     od;
  403.     p*.f_flags := SHARK;
  404.     p*.s_age := CRT_Random(SBreed);
  405.     p*.s_eat := CRT_Random(Starve);
  406.     CRT_Move(l, c);
  407.     CRT_PutChar('0');
  408.     od;
  409. corp;
  410.  
  411. /*
  412.  * restoreOcean - restore the state from a file and write screen.
  413.  */
  414.  
  415. proc restoreOcean()void:
  416.     *CELL p;
  417.     uint i;
  418.  
  419.     CRT_ClearScreen();
  420.     p := &Ocean[0, 0];
  421.     for i from 0 upto NLINES * NCOLUMNS - 1 do
  422.     CRT_PutChar(
  423.         if p*.f_flags & SHARK ~= 0x00 then
  424.         '0'
  425.         elif p*.f_flags & FISH ~= 0x00 then
  426.         '.'
  427.         else
  428.         ' '
  429.         fi
  430.     );
  431.     p := p + sizeof(CELL);
  432.     od;
  433.     write(CRTOut;
  434.     "NSharks: ", NSharks : 4,
  435.     "  NFish: ", NFish : 4,
  436.     "  Time: ", Time : 5,
  437.     "  SBreed: ", SBreed : 2,
  438.     "  FBreed: ", FBreed : 2,
  439.     "  Starve: ", Starve : 2
  440.     );
  441. corp;
  442.  
  443. /*
  444.  * main - main program - handles setup, restore, save and running.
  445.  */
  446.  
  447. proc main()void:
  448.     *char p;
  449.     channel input binary restore;
  450.     channel output binary save;
  451.     [100] char buffer;
  452.  
  453.     Logging := false;
  454.     p := GetPar();
  455.     if p ~= nil and p* = '-' then
  456.     case (p + 1)*
  457.     incase 'l':
  458.     incase 'L':
  459.         Logging := true;
  460.     default:
  461.         writeln("*** Invalid flag '", (p + 1)*, "' - aborting. ***");
  462.         exit(1);
  463.     esac;
  464.     p := GetPar();
  465.     fi;
  466.     CRT_Initialize("Wator", NLINES + 1, NCOLUMNS);
  467.     open(CRTOut, CRT_PutChar);
  468.     if p = nil then
  469.     /*
  470.      * start a new run.
  471.      */
  472.     initialize();
  473.     getParameters();
  474.     initializeOcean();
  475.     else
  476.     /*
  477.      * restore a run from a save file.
  478.      */
  479.     if not open(restore, File, p) then
  480.         writeln("*** Can't open restore file ",
  481.             p, " - aborting. ***");
  482.         CRT_Abort();
  483.     fi;
  484.     read(restore; NFish, NSharks, SBreed, FBreed, Starve, Ocean, Time);
  485.     close(restore);
  486.     restoreOcean();
  487.     fi;
  488.     if Logging then
  489.     if not FileDestroy("wator.log") then fi;
  490.     if not FileCreate("wator.log") then
  491.         writeln("*** Can't create log file wator.log - aborting. ***");
  492.         CRT_Abort();
  493.     fi;
  494.     open(LogOut, File, "WATOR.LOG");
  495.     writeln(LogOut; NSharks, ' ', NFish);
  496.     fi;
  497.     while (NFish ~= 0 or NSharks ~= 0) and not CRT_GotChar() do
  498.     updateFish();
  499.     updateSharks();
  500.     updateDisplay();
  501.     od;
  502.     if Logging then
  503.     close(LogOut);
  504.     fi;
  505.     while
  506.     CRT_ClearLine(NLINES);
  507.     CRT_PutChars("File to save to (<CR> to abandon run): ");
  508.     CRT_GetLine(&buffer[0], 15);
  509.     p := &buffer[0];
  510.     while p* = ' ' do
  511.         p := p + 1;
  512.     od;
  513.     CRT_ClearLine(NLINES - 1);
  514.     if p* = '\e' then
  515.         CRT_PutChars("Run abandoned.");
  516.         false
  517.     else
  518.         if FileDestroy(p) then fi;
  519.         if FileCreate(p) then
  520.         open(save, File, p);
  521.         write(save; NFish, NSharks, SBreed, FBreed, Starve,
  522.                 Ocean, Time);
  523.         close(save);
  524.         CRT_PutChars("Run saved.");
  525.         false
  526.         else
  527.         write(CRTOut; "*** Can't create save file ", p, ". ***");
  528.         true
  529.         fi
  530.     fi
  531.     do
  532.     od;
  533.     CRT_Terminate();
  534. corp;
  535.